home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / gus / vts139b.zip / VTPARTIT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-15  |  10KB  |  443 lines
  1. UNIT VTPartitura;
  2.  
  3. INTERFACE
  4.  
  5. USES SongUnit, PlayMod,
  6.      Output43;
  7.  
  8. VAR
  9.   IsBig       : BOOLEAN;
  10.   PartWin     : PWindow;
  11. {
  12.   ForceReDraw : BOOLEAN;
  13. }
  14.  
  15.  
  16.  
  17.  
  18.  
  19. PROCEDURE SetPartWindow(x, y, p, f: WORD);
  20.  
  21. PROCEDURE SetBigPartWindow;
  22.  
  23. PROCEDURE SetSmallPartWindow;
  24.  
  25. PROCEDURE DrawPartiture(VAR Song: TSong; mdpos, mdseq: WORD);
  26.  
  27.  
  28.  
  29.  
  30. IMPLEMENTATION
  31.  
  32. USES VTPlay, VTWins, VTBitmaps,
  33.      SongUtils, SongElements,
  34.      HexConversions;
  35.  
  36. TYPE
  37.   TFullNoteStr = STRING[20];
  38.  
  39. VAR
  40.   wx, wn,
  41.   py, fy,
  42.   hp, hf,
  43.  
  44.   PastNotes,
  45.   FutNotes,
  46.   TotNotes,
  47.   ActNote,
  48.   FirstNote   : WORD;
  49.  
  50.   ps          : ARRAY[1..53] OF ARRAY[1..4] OF TFullNoteStr;
  51.   fs          : ARRAY[1..53] OF ARRAY[1..4] OF BOOLEAN;
  52.   ls          : ARRAY[1..53] OF ARRAY[1..4] OF TFullNote;
  53.  
  54.   Permit      : ARRAY[1..4] OF BOOLEAN;
  55.  
  56.   omdpos,
  57.   omdseq      : WORD;
  58.  
  59.   wPastIdx,
  60.   wActIdx,
  61.   wFutIdx     : TWindow;
  62.   wPast,
  63.   wAct,
  64.   wFut        : TChWindows;
  65.  
  66.  
  67.  
  68.  
  69.  
  70. PROCEDURE SetPartWindow(x, y, p, f: WORD);
  71.   BEGIN
  72.     wx := x;
  73.     wn := 20;
  74.     py := y;
  75.     fy := y + p + 5;
  76.     hp := p + 2;
  77.     hf := f + 2;
  78.  
  79.     FillChar(Permit, SIZEOF(Permit), 0);
  80.  
  81.     PastNotes   := p;
  82.     FutNotes    := f;
  83.     TotNotes    := p+f+1;
  84.     ActNote     := p+1;
  85.   END;
  86.  
  87.  
  88.  
  89.  
  90. PROCEDURE SetBigPartWindow;
  91.   BEGIN
  92.     wPastIdx := wPartPastBIdx;
  93.     wActIdx  := wPartActBIdx;
  94.     wFutIdx  := wPartFutBIdx;
  95.     wPast    := wPartPastBig;
  96.     wAct     := wPartActBig;
  97.     wFut     := wPartFutBig;
  98.     PartWin  := @wPartBig;
  99.  
  100.     PastNotes   := 26;
  101.     FutNotes    := 26;
  102.     TotNotes    := 53;
  103.     ActNote     := 27;
  104.     IsBig       := TRUE;
  105.   END;
  106.  
  107.  
  108.  
  109.  
  110. PROCEDURE SetSmallPartWindow;
  111.   BEGIN
  112.     wPastIdx := wPartPastIdx;
  113.     wActIdx  := wPartActIdx;
  114.     wFutIdx  := wPartFutIdx;
  115.     wPast    := wPartPast;
  116.     wAct     := wPartAct;
  117.     wFut     := wPartFut;
  118.     PartWin  := @wPartSmall;
  119.  
  120.     PastNotes   := 7;
  121.     FutNotes    := 7;
  122.     TotNotes    := 15;
  123.     ActNote     := 8;
  124.     IsBig       := FALSE;
  125.   END;
  126.  
  127.  
  128.  
  129.  
  130.  
  131. PROCEDURE InsertStr(VAR s, t: STRING; p: WORD); ASSEMBLER;
  132.   ASM
  133.         PUSH    DS
  134.         CLD
  135.         LDS     SI,t
  136.         LES     DI,s
  137.         MOV     AX,p
  138.         ADD     DI,AX
  139.         LODSB
  140.         MOV     CL,AL
  141.         XOR     CH,CH
  142.         REP MOVSB
  143.         POP     DS
  144.   END;
  145.  
  146.  
  147.  
  148. PROCEDURE StrNote(nt: TFullNote; VAR s: TFullNoteStr);
  149.   CONST
  150.     Commands : ARRAY[mcNone..mcLast] OF STRING[5] = (
  151.       '····',
  152.  
  153.       'ARPG', 'TPUP', 'TPDN', 'NOTP',
  154.       'VIBR', 'TVSL', 'VVSL', 'TREM',
  155.       'XX-1', 'SOFF', 'VSLD', 'JUMP',
  156.       'VOLM', 'BRCK', 'XX-2', 'TEMP',
  157.  
  158.       'FILT', 'FPUP', 'FPDN', 'GLIS',
  159.       'VCTL', 'FTUN', 'LOOP', 'TRMC',
  160.       '?? 3', 'RETN', 'VFUP', 'VFDN',
  161.       'NCUT', 'NDLY', 'PDLY', 'FUNK',
  162.  
  163.       'ARP1', 'ARP2', 'S3MR',
  164.  
  165.       '····'
  166.     );
  167.   VAR
  168.     bs : STRING[16];
  169.   BEGIN
  170.  
  171.     s := ' ·················· ';
  172.  
  173.     IF (nt.Period <> 0) OR (nt.Instrument <> 0) THEN
  174.       BEGIN
  175.         s[8] := ' ';
  176.         s[5] := ' ';
  177.  
  178.         IF nt.Period = 0 THEN
  179.           BEGIN
  180.             bs := '---';
  181.             InsertStr(s, bs, 2);
  182.           END
  183.         ELSE
  184.           BEGIN
  185.             NoteFreq(nt.Period, bs);
  186.             InsertStr(s, bs, 2);
  187.           END;
  188.  
  189.         IF nt.Instrument = 0 THEN
  190.           BEGIN
  191.             bs := '--';
  192.             InsertStr(s, bs, 6);
  193.           END
  194.         ELSE
  195.           BEGIN
  196.             STR(nt.Instrument : 2, bs);
  197.             IF bs[1] = ' ' THEN bs[1] := '0';
  198.             InsertStr(s, bs, 6);
  199.       END;
  200.       END;
  201.  
  202.     IF nt.Volume <> 0 THEN
  203.       BEGIN
  204.         s[9]  := ' ';
  205.         s[12] := ' ';
  206.         STR(nt.volume-1 : 2, bs);
  207.         IF bs[1] = ' ' THEN
  208.           s[10] := '0'
  209.         ELSE
  210.           s[10] := bs[1];
  211.         s[11] := bs[2];
  212.       END;
  213.  
  214.     IF nt.Command <> mcNone THEN
  215.       BEGIN
  216.         s[12] := ' ';
  217.         s[17] := ' ';
  218.  
  219.         IF nt.Command < mcLast THEN
  220.           InsertStr(s, Commands[nt.Command], 13)
  221.         ELSE
  222.           BEGIN
  223.             STR(ORD(nt.Command) - ORD(mcLast) : 2, bs);
  224.             bs := 'X-'+bs;
  225.             InsertStr(s, bs, 13);
  226.           END;
  227.  
  228.         bs := HexByte(nt.Parameter);
  229.         InsertStr(s, bs, 18);
  230.       END;
  231.   END;
  232.  
  233.  
  234.  
  235.  
  236. PROCEDURE DrawPartiture(VAR Song: TSong; mdpos, mdseq: WORD);
  237.   CONST
  238.     EmptyLine : STRING[20] = '                    ';
  239.     count : WORD = 0;
  240.   VAR
  241.     PattSize : WORD;
  242.     nn   : WORD;
  243.     n, w,
  244.     k, p : INTEGER;
  245.     i, j : WORD;
  246.     nt   : TFullNote;
  247.     strn : STRING;
  248.   BEGIN
  249.  
  250.     IF NOT (PartWin^.vis AND PartWin^.act) THEN EXIT;
  251.  
  252.     FOR j := 1 TO 4 DO BEGIN
  253.  
  254.       IF PartWin^.forz THEN
  255.         BEGIN
  256.           STR(FirstChannel-1+j : 2, strn);
  257.           WITH wPast[j] DO 
  258.             DirectWriteAttr(ParseCoords(x+13, y), strn, BYTE(col[4]));
  259.         END;
  260.  
  261.  
  262.       IF NOT Permisos[FirstChannel - 1 + j] THEN BEGIN
  263.         IF {Permit[j] OR }PartWin^.forz THEN BEGIN
  264.           WITH wPast[j] DO BEGIN
  265.             FOR i := 1 TO PastNotes DO
  266.               DirectWriteAttr(ParseCoords(x + 1, y+i), EmptyLine, BYTE(col[3]));
  267.             WriteVTLogo(ParseCoords(x + 7, y+(PastNotes - 1) DIV 2 - 1));
  268.           END;
  269.  
  270.           WITH wAct[j] DO BEGIN
  271.             FOR i := 1 TO 2 DO
  272.               DirectWriteAttr(ParseCoords(x + 1, y+i), EmptyLine, BYTE(col[1]));
  273.             WriteVTNoPartAct(ParseCoords(x + 3, y+1));
  274.           END;
  275.  
  276.           WITH wFut[j] DO BEGIN
  277.             FOR i := 1 TO FutNotes DO
  278.               DirectWriteAttr(ParseCoords(x + 1, y+i), EmptyLine, BYTE(col[3]));
  279.             WriteVTLogo(ParseCoords(x + 7, y+(FutNotes - 1) DIV 2 - 1));
  280.           END;
  281.         END;
  282.       END;
  283.  
  284.       Permit[j] := Permisos[FirstChannel - 1 + j];
  285.     END;
  286. {
  287.     PartWin^.forz := TRUE;
  288. }
  289.     PattSize := 0;
  290.     IF (Song.GetPatternSeq(mdseq)       <> NIL) AND
  291.        (Song.GetPatternSeq(mdseq)^.Patt <> NIL) THEN
  292.       PattSize := Song.GetPatternSeq(mdseq)^.Patt^.NNotes;
  293.  
  294.     IF PartWin^.forz OR (mdseq <> omdseq) OR
  295.        (WORD(mdpos - omdpos) >= FutNotes) THEN BEGIN
  296.  
  297.       FirstNote := 1;
  298.  
  299.       n := mdpos - PastNotes;
  300.       w := 1;
  301.  
  302.       FOR i := 1 TO PastNotes + FutNotes + 1 DO
  303.         BEGIN
  304.           IF (WORD(n) <= PattSize) AND (n <> 0) THEN
  305.             FOR j := 1 TO 4 DO
  306.               BEGIN
  307.                 Song.GetNote(mdseq, n, FirstChannel - 1 + j, nt);
  308.                 ls[w][j] := nt;
  309.                 fs[w][j] := TRUE;
  310.                 StrNote(nt, ps[w][j]);
  311.               END
  312.           ELSE
  313.             FOR j := 1 TO 4 DO
  314.               BEGIN
  315.                 ls[w][j].Instrument := $FF;
  316.                 fs[w][j] := TRUE;
  317.                 ps[w][j] := '                    ';
  318.               END;
  319.           INC(n); INC(w);
  320.         END;
  321.  
  322.     END ELSE BEGIN
  323.  
  324.       k := mdpos - omdpos;
  325.       IF k = 0 THEN EXIT;
  326.       IF k > 0 THEN BEGIN
  327.         p := 1;
  328.         n := omdpos + FutNotes + 1;
  329.       END;
  330.  
  331.       w  := FirstNote;
  332.       nn := ((FirstNote - 1 + TotNotes + k) MOD TotNotes) + 1;
  333.       FOR i := 1 TO TotNotes - k DO BEGIN
  334.         FOR j := 1 TO 4 DO
  335.           fs[nn][j] := NOT FullNotesEqual(ls[nn][j], ls[w][j]);
  336.         w  := (w  MOD TotNotes) + 1;
  337.         nn := (nn MOD TotNotes) + 1;
  338.       END;
  339.  
  340.       w := FirstNote;
  341.       FirstNote := ((FirstNote - 1 + TotNotes + k) MOD TotNotes) + 1;
  342.  
  343.       FOR i := 1 TO ABS(k) DO BEGIN
  344.         IF (WORD(n) <= PattSize) AND (n <> 0) THEN
  345.           FOR j := 1 TO 4 DO
  346.             BEGIN
  347.               Song.GetNote(mdseq, n, FirstChannel - 1 + j, nt);
  348.               ls[w][j] := nt;
  349.               fs[w][j] := TRUE;
  350.               StrNote(nt, ps[w][j]);
  351.             END
  352.         ELSE
  353.           FOR j := 1 TO 4 DO
  354.             BEGIN
  355.               fs[w][j] := ls[w][j].Instrument <> $FF;
  356.               ls[w][j].Instrument := $FF;
  357.               ps[w][j] := '                    ';
  358.             END;
  359.         INC(n, p);
  360.         w := ((w - 1 + TotNotes + p) MOD TotNotes) + 1;
  361.       END;
  362.  
  363.     END;
  364.  
  365.     n  := FirstNote;
  366.     nn := mdpos - PastNotes;
  367.  
  368.     FOR i := 1 TO PastNotes DO BEGIN
  369.       WITH wPastIdx DO BEGIN
  370.         STR(nn : 3, strn);
  371.         IF (nn <= PattSize) AND (nn <> 0) THEN
  372.           DirectWriteAttr(ParseCoords(x+1, y+i), strn, BYTE(col[1]))
  373.         ELSE
  374.           DirectWriteAttr(ParseCoords(x+1, y+i), '   ', BYTE(col[2]));
  375.       END;
  376.  
  377. {
  378.       IF ps[n][1][0] <> #0 THEN
  379. }
  380.         FOR j := 1 TO 4 DO
  381.           IF fs[n][j] THEN
  382.             IF Permisos[FirstChannel - 1 + j] THEN
  383.               WITH wPast[j] DO IF ls[n][j].Instrument = $FF THEN
  384.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[2]))
  385.               ELSE
  386.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[1]));
  387.       n := (n MOD TotNotes) + 1;
  388.       INC(nn);
  389.     END;
  390.  
  391.     WITH wActIdx DO BEGIN
  392.       IF nn < 100 THEN
  393.         STR(nn : 3, strn)
  394.       ELSE
  395.         strn := '   ';
  396.       DirectWriteBig(ParseCoords(x+1, y+1), strn)
  397.     END;
  398.  
  399.     FOR j := 1 TO 4 DO
  400.       IF fs[n][j] THEN
  401.         IF Permisos[FirstChannel - 1 + j] THEN
  402.           WITH wAct[j] DO BEGIN
  403.             RectAttr       (ParseCoords(x+1, y+1), 18, 2, BYTE(col[1]));
  404.             DirectWriteBig (ParseCoords(x+1, y+1), ps[n][j]);
  405.           END;
  406.     n := (n MOD TotNotes) + 1;
  407.     INC(nn);
  408.  
  409.     FOR i := 1 TO FutNotes DO BEGIN
  410.       WITH wFutIdx DO BEGIN
  411.         STR(nn : 3, strn);
  412.         IF (nn <= PattSize) AND (n <> 0) THEN
  413.           DirectWriteAttr(ParseCoords(x+1, y+i), strn, BYTE(col[1]))
  414.         ELSE
  415.           DirectWriteAttr(ParseCoords(x+1, y+i), '   ', BYTE(col[2]));
  416.       END;
  417.  
  418. {
  419.       IF ps[n][1][0] <> #0 THEN
  420. }
  421.         FOR j := 1 TO 4 DO
  422.           IF fs[n][j] THEN
  423.             IF Permisos[FirstChannel - 1 + j] THEN
  424.               WITH wFut[j] DO IF ls[n][j].Instrument = $FF THEN
  425.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[2]))
  426.               ELSE
  427.                 DirectWriteAttr(ParseCoords(x + 1, y+i), ps[n][j], BYTE(col[1]));
  428.       n := (n MOD TotNotes) + 1;
  429.       INC(nn);
  430.     END;
  431.  
  432.     omdseq := mdseq;
  433.     omdpos := mdpos;
  434.  
  435.     PartWin^.forz := FALSE;
  436.  
  437.   END;
  438.  
  439.  
  440.  
  441.  
  442. END.
  443.